module Game.Trubis.Pipe (
  Pipe(),
  pipeAt,
  toList,
  closed,
  positions,
) where

import Game.Trubis.Position
import Game.Trubis.Field
import Game.Trubis.PipeSection
import Data.Array
import Data.Array.ST
import Data.Array.Extra
import Data.Maybe
import Data.Function

-- | A set of connected `PipeSection`s.
data Pipe = Pipe
  { toList :: [(Position, PipeSection)]
  , closed :: Bool
  -- ^ A `Pipe` is `closed` iff there are no "leaks", i.e. all outputs of all
  -- `PipeSection`s in the `Pipe` are connected.
  }

pipeAt :: Field -> Position -> Pipe
pipeAt field pos = Pipe
  { toList =
      a & assocs & map (\(pos, e) -> (pos,) <$> e) & catMaybes
      & map (\(pos, (_, section)) -> (pos, section))
  , closed = a & elems & catMaybes & map fst & all id
  }
 where
  a = runSTArray $ do
    {- a :: Array Position (visited (allOutputsConnected, PipeSection)) -}
    a <- newArray (bounds field) Nothing
    let visited pos = isJust <$> readArray a pos
    let visit pos = do
          if not $ inRange (bounds field) pos then return ()
          else do
            visited pos >>= \case
              True -> return ()
              False -> case field !?? pos of
                Nothing -> return ()
                Just s -> do
                  let occupiedOutputs = outputPositions (pos, s)
                        & map (\pos -> (pos,) <$> field !?? pos)
                        & catMaybes
                        :: [(Position, PipeSection)]
                  let connectedOutputs = occupiedOutputs
                        & filter ((pos `elem`) . outputPositions)
                  let connectedOutputPositions = connectedOutputs & map fst
                  let allOutputsConnected =
                        length (outputDirections s) == length connectedOutputs
                  writeArray a pos $ Just (allOutputsConnected, s)
                  mapM_ visit connectedOutputPositions
    visit pos
    return a
  outputPositions (pos, s) = outputDirections s & map (pos ^+^)

positions :: Pipe -> [Position]
positions Pipe{..} = toList & map fst

